home *** CD-ROM | disk | FTP | other *** search
/ Programming Sound Cards / Programming Sound Cards.iso / sound_87 / oktloade.pas < prev    next >
Pascal/Delphi Source File  |  1995-01-01  |  12KB  |  465 lines
  1. UNIT OktLoader;
  2.  
  3. INTERFACE
  4.  
  5. USES Objects, SongUnit;
  6.  
  7.  
  8.  
  9.  
  10. PROCEDURE LoadOktFileFormat (VAR Song: TSong; VAR St: TStream; VAR Header: TSongHeader);
  11.  
  12.  
  13.  
  14.  
  15. IMPLEMENTATION
  16.  
  17. USES SongUtils, SongElements, IFF, AsciiZ;
  18.  
  19.  
  20.  
  21.  
  22. TYPE
  23.   TModOktIdString = ARRAY[1..8] OF CHAR; { Oktalizer Id string (at the start of the file). }
  24.  
  25. CONST
  26.   ModOktIdString : TModOktIdString = ('O', 'K', 'T', 'A', 'S', 'O', 'N', 'G');
  27.  
  28. TYPE
  29.  
  30.   { Note in the file. 4 bytes. }
  31.  
  32.   POktFileNote = ^TOktFileNote;
  33.   TOktFileNote = RECORD
  34.     CASE INTEGER OF
  35.       1: (l              : LONGINT);
  36.       2: (w1, w2         : WORD);
  37.       3: (b1, b2, b3, b4 : BYTE);
  38.   END;
  39.  
  40.   POktFilePattern = ^TOktFilePattern;
  41.   TOktFilePattern =
  42.     RECORD
  43.       CASE BYTE OF
  44.         4 : ( Patt4 : ARRAY [0..63] OF ARRAY [1..4] OF TOktFileNote );
  45.         5 : ( Patt5 : ARRAY [0..63] OF ARRAY [1..5] OF TOktFileNote );
  46.         6 : ( Patt6 : ARRAY [0..63] OF ARRAY [1..6] OF TOktFileNote );
  47.         7 : ( Patt7 : ARRAY [0..63] OF ARRAY [1..7] OF TOktFileNote );
  48.         8 : ( Patt8 : ARRAY [0..63] OF ARRAY [1..8] OF TOktFileNote );
  49.     END;                                                   
  50.  
  51.  
  52.  
  53.  
  54.  
  55. TYPE
  56.   TOktFile =
  57.     OBJECT(TIffFile)
  58.       Song           : PSong;
  59.       OktPBODCount   : WORD;
  60.       OktSBODCount   : WORD;
  61.       OktTrackCount  : WORD;
  62.       OktMaxChannels : WORD;
  63.  
  64.       CONSTRUCTOR Init(VAR MySong: TSong);
  65.       DESTRUCTOR  Done; VIRTUAL;
  66.  
  67.       FUNCTION  DoBlock(VAR St: TStream;
  68.                         Id: TIffBlockIdent; Size: LONGINT) : BOOLEAN; VIRTUAL;
  69.  
  70.       FUNCTION  OktProcCMOD(VAR St: TStream; Size: LONGINT) : BOOLEAN;
  71.       FUNCTION  OktProcSAMP(VAR St: TStream; Size: LONGINT) : BOOLEAN;
  72.       FUNCTION  OktProcSPEE(VAR St: TStream; Size: LONGINT) : BOOLEAN;
  73.       FUNCTION  OktProcSLEN(VAR St: TStream; Size: LONGINT) : BOOLEAN;
  74.       FUNCTION  OktProcPLEN(VAR St: TStream; Size: LONGINT) : BOOLEAN;
  75.       FUNCTION  OktProcPATT(VAR St: TStream; Size: LONGINT) : BOOLEAN;
  76.       FUNCTION  OktProcPBOD(VAR St: TStream; Size: LONGINT) : BOOLEAN;
  77.       FUNCTION  OktProcSBOD(VAR St: TStream; Size: LONGINT) : BOOLEAN;
  78.     END;
  79.  
  80.  
  81.  
  82.  
  83.  
  84.  
  85.  
  86.  
  87.  
  88.  
  89. FUNCTION TOktFile.OktProcCMOD(VAR St: TStream; Size: LONGINT) : BOOLEAN;
  90.   VAR
  91.     MyBuff :
  92.       RECORD
  93.         w1     : WORD;
  94.         w2     : WORD;
  95.         w3     : WORD;
  96.         w4     : WORD;
  97.       END;
  98.   BEGIN
  99.     OktProcCMOD := FALSE;
  100.     IF Size <> 8 THEN EXIT;
  101.  
  102.     St.Read(MyBuff, Size);
  103.  
  104.     { Ignore the words until we know what they mean. I just know they are "channel modes". }
  105.  
  106.     OktProcCMOD := TRUE;
  107.   END;
  108.  
  109.  
  110. FUNCTION TOktFile.OktProcSAMP(VAR St: TStream; Size: LONGINT) : BOOLEAN;
  111.   TYPE
  112.     TOktFileInstrument = RECORD
  113.       Name       : ARRAY [1..20] OF CHAR; { AsciiZ string, name of the instrument. }
  114.       Len        : LONGINT;               { Length of the sample DIV.              }
  115.       RepS       : WORD;
  116.       RepL       : WORD;
  117.       fill1      : BYTE;
  118.       Vol        : BYTE;                  { Default volume.                        }
  119.       fill2      : WORD;
  120.     END;
  121.   VAR
  122.     MyBuff     : TOktFileInstrument;
  123.     Instr      : TInstrumentRec;
  124.     Instrument : PInstrument;
  125.     r          : WORD;
  126.     i          : WORD;
  127.     Rest       : LONGINT;
  128.   BEGIN
  129.     OktProcSAMP := FALSE;
  130.     IF Size MOD 32 <> 0 THEN EXIT;
  131.  
  132.     FillChar(Instr, SizeOf(Instr), 0);
  133.  
  134.     Instr.Data  := NIL;
  135.     Instr.Xtra  := NIL;
  136.     Instr.FTune := 0;
  137.     Instr.Prop  := 0;
  138.  
  139.     i := 1;
  140.     WHILE Size >= 32 DO
  141.       BEGIN
  142.         St.Read(MyBuff, 32);
  143.         Instr.len  := SwapLong(MyBuff.Len);
  144.         Instr.reps := SWAP(MyBuff.RepS) SHL 1;
  145.         Instr.repl := SWAP(MyBuff.RepL) SHL 1;
  146.         Instr.vol  := MyBuff.Vol;
  147.  
  148.         Instrument := Song^.GetInstrument(i);
  149.         IF Instr.Len > 0 THEN
  150.           Instrument^.Change(@Instr)
  151.         ELSE
  152.           Instrument^.Change(NIL);
  153.         Instrument^.SetName(StrASCIIZ(MyBuff.Name, 20) + '  ');
  154.  
  155.         INC(i);
  156.         DEC(Size, 32);
  157.       END;
  158.  
  159.     OktProcSAMP := TRUE;
  160.   END;
  161.  
  162.  
  163. FUNCTION TOktFile.OktProcSPEE(VAR St: TStream; Size: LONGINT) : BOOLEAN;
  164.   VAR
  165.     Spee : WORD;
  166.   BEGIN
  167.     OktProcSPEE := FALSE;
  168.     IF Size <> 2 THEN EXIT;
  169.  
  170.     St.Read(Spee, 2);
  171.  
  172.     Song^.InitialTempo := SWAP(Spee);
  173.  
  174.     OktProcSPEE := TRUE;
  175.   END;
  176.  
  177.  
  178. FUNCTION TOktFile.OktProcSLEN(VAR St: TStream; Size: LONGINT) : BOOLEAN;
  179.   BEGIN
  180.     OktProcSLEN := TRUE;
  181.   END;
  182.  
  183.  
  184. FUNCTION TOktFile.OktProcPLEN(VAR St: TStream; Size: LONGINT) : BOOLEAN;
  185.   VAR
  186.     Len  : WORD;
  187.   BEGIN
  188.     OktProcPLEN := FALSE;
  189.     IF Size <> 2 THEN EXIT;
  190.  
  191.     St.Read(Len, 2);
  192.  
  193.     Song^.SequenceLength := SWAP(Len);
  194.  
  195.     OktProcPLEN := TRUE;
  196.   END;
  197.  
  198.  
  199. FUNCTION TOktFile.OktProcPATT(VAR St: TStream; Size: LONGINT) : BOOLEAN;
  200.   VAR
  201.     i : WORD;
  202.   BEGIN
  203.     IF Size > MaxSequence THEN
  204.       Size := MaxSequence;
  205.  
  206.     St.Read(Song^.PatternSequence^, Size);
  207.  
  208.     FOR i := 1 TO SizeOf(Song^.PatternSequence^) DO
  209.       INC(Song^.PatternSequence^[i]);
  210.  
  211.     OktProcPATT := TRUE;
  212.   END;
  213.  
  214.  
  215. FUNCTION TOktFile.OktProcPBOD(VAR St: TStream; Size: LONGINT) : BOOLEAN;
  216.   CONST
  217.     FreqTable : ARRAY[0..35] OF WORD =
  218.       (
  219.         $0358,$0328,$02FB,$02D0,$02A7,$0281,$025D,$023B,$021B,$01FD,$01E0,$01C5,
  220.         $01AC,$0194,$017D,$0168,$0154,$0141,$012F,$011E,$010E,$00FE,$00F0,$00E3,
  221.         $00D6,$00CA,$00BF,$00B4,$00AA,$00A0,$0097,$008F,$0087,$007F,$0078,$0071
  222.       );
  223.   VAR
  224.     i, j        : WORD;
  225.     Length      : WORD;
  226.     NumChannels : WORD;
  227.     Patt        : TOktFilePattern;
  228.     Pattern     : PPattern;
  229.     FullTrack   : TFullTrack;
  230.     Track       : PTrack;
  231.   BEGIN
  232.     OktProcPBOD := FALSE;
  233.     IF Size < 6 THEN EXIT;
  234.     IF Size > SizeOf(TOktFilePattern) + 2 THEN EXIT;
  235.  
  236.     St.Read(Length, 2);
  237.     Length := SWAP(Length);
  238.     IF Length > 64 THEN EXIT;
  239.     NumChannels := (Size - 2) DIV (Length * 4);
  240.     IF NumChannels > 8 THEN EXIT;
  241.     IF NumChannels > OktMaxChannels THEN
  242.       OktMaxChannels := NumChannels;
  243.  
  244.     Pattern := Song^.GetPattern(OktPBODCount);
  245.     WITH Pattern^.Patt^ DO
  246.       BEGIN
  247.         NNotes := Length;
  248.         Tempo  := 0;
  249.         BPM    := 0;
  250.       END;
  251.  
  252.     St.Read(Patt, Size-2);
  253.  
  254.     CASE NumChannels OF
  255.       4 : FOR i := 63 DOWNTO 0 DO
  256.             FOR j := NumChannels DOWNTO 1 DO
  257.               Patt.Patt8[i][j] := Patt.Patt4[i][j];
  258.       5 : FOR i := 63 DOWNTO 0 DO
  259.             FOR j := NumChannels DOWNTO 1 DO
  260.               Patt.Patt8[i][j] := Patt.Patt5[i][j];
  261.       6 : FOR i := 63 DOWNTO 0 DO
  262.             FOR j := NumChannels DOWNTO 1 DO
  263.               Patt.Patt8[i][j] := Patt.Patt6[i][j];
  264.       7 : FOR i := 63 DOWNTO 0 DO
  265.             FOR j := NumChannels DOWNTO 1 DO
  266.               Patt.Patt8[i][j] := Patt.Patt7[i][j];
  267.     END;
  268.  
  269.     FillChar(FullTrack, SizeOf(FullTrack), 0);
  270.  
  271.     FOR j := 1 TO NumChannels DO
  272.       BEGIN
  273.         FOR i := 0 TO Length - 1 DO
  274.           WITH FullTrack[i], Patt.Patt8[i][j] DO
  275.             BEGIN
  276.               Command := mcNone;
  277.               Parameter := b4;
  278.               
  279.               CASE b3 OF
  280. { rs_portd-p   } $1 : Command := mcTPortDown;
  281. { rs_portu-p   } $2 : Command := mcTPortUp; 
  282. { rs_arp-p     } $A : Command := mcOktArp;
  283. { rs_arp2-p    } $B : Command := mcOktArp2;
  284.                  $D : Command := mcNone; { rs_slided-p  }
  285. { p-rs_filt    } $F : Command := mcSetFilter;
  286.                 $11 : Command := mcNone; { p-rs_slideu  }
  287.                 $15 : Command := mcNone; { p-rs_slided  }
  288. { p-rs_posjmp  }$19 : BEGIN
  289.                         Command   := mcJumpPattern;
  290.                         Parameter := (Parameter AND $F) + (Parameter SHR 4)*10 + 1;
  291.                       END;
  292. { p-rs_release }$1B : Command := mcRetrigNote;
  293. { p-rs_cspeed  }$1C : Command := mcSetTempo;
  294.                 $1E : Command := mcNone; { rs_slideu-p  }
  295. { rs_volume-p  }$1F : BEGIN
  296.                         IF Parameter <= 64 THEN
  297.                           BEGIN
  298.                             Command := mcSetVolume;
  299.                           END
  300.                         ELSE IF Parameter < $50 THEN
  301.                           BEGIN
  302.                             Command   := mcVolSlide;
  303.                             Parameter := Parameter - $40;
  304.                           END
  305.                         ELSE IF Parameter < $60 THEN
  306.                           BEGIN
  307.                             Command   := mcVolFineDown;
  308.                             Parameter := Parameter - $50;
  309.                           END
  310.                         ELSE IF Parameter < $70 THEN
  311.                           BEGIN
  312.                             Command   := mcVolSlide;
  313.                             Parameter := (Parameter - $60) SHL 4;
  314.                           END
  315.                         ELSE IF Parameter < $80 THEN
  316.                           BEGIN
  317.                             Command   := mcVolFineUp;
  318.                             Parameter := Parameter - $70;
  319.                           END
  320.                       END;
  321.                 ELSE  Command := mcNone;
  322.               END;
  323.  
  324.               IF b1 = 0 THEN
  325.                 BEGIN
  326.                   Period     := 0;
  327.                   Instrument := 0;
  328.                 END
  329.               ELSE
  330.                 BEGIN
  331.                   Period     := FreqTable[b1-1];
  332.                   Instrument := b2 + 1;
  333.                 END;
  334.  
  335.               IF ((Command = mcEndPattern) OR (Command = mcJumpPattern)) AND
  336.                  (Pattern^.Patt^.NNotes > i + 1) THEN
  337.                 Pattern^.Patt^.NNotes := i + 1;
  338.             END;
  339.  
  340.         Track := Song^.GetTrack(OktTrackCount);
  341.         IF Track = NIL THEN
  342.           BEGIN
  343.             Song^.Status := msOutOfMemory;
  344.             EXIT;
  345.           END;
  346.  
  347.         Track^.SetFullTrack(FullTrack);
  348.  
  349.         Pattern^.Patt^.Channels[j] := OktTrackCount;
  350.  
  351.         INC(OktTrackCount);
  352.       END;
  353.  
  354.     INC(OktPBODCount);
  355.     OktProcPBOD := TRUE;
  356.   END;
  357.  
  358.  
  359. FUNCTION TOktFile.OktProcSBOD(VAR St: TStream; Size: LONGINT) : BOOLEAN;
  360.   VAR
  361.     Instrument : PInstrumentRec;
  362.   BEGIN
  363.     OktProcSBOD := FALSE;
  364.  
  365.     WHILE (OktSBODCount <= 256) AND
  366.           ((Song^.GetInstrument(OktSBODCount)^.Instr      = NIL)  OR
  367.            (Song^.GetInstrument(OktSBODCount)^.Instr^.Len = 0)  ) DO
  368.       INC(OktSBODCount);
  369.  
  370.     Instrument := Song^.GetInstrument(OktSBODCount)^.Instr;
  371.     IF Instrument = NIL THEN EXIT;
  372.  
  373.     Instrument^.Len := Size;
  374.  
  375.     GetMem(Instrument^.Data, Size);
  376.  
  377.     St.Read(Instrument^.Data^, Size);
  378.  
  379.     INC(OktSBODCount);
  380.     OktProcSBOD := TRUE;
  381.   END;
  382.  
  383.  
  384.  
  385.  
  386. FUNCTION TOktFile.DoBlock(VAR St: TStream;
  387.                           Id: TIffBlockIdent; Size: LONGINT) : BOOLEAN; 
  388.   BEGIN
  389.     DoBlock := FALSE;
  390.  
  391.     IF      (Id = 'CMOD') AND NOT OktProcCMOD(St, Size) THEN EXIT
  392.     ELSE IF (Id = 'SAMP') AND NOT OktProcSAMP(St, Size) THEN EXIT
  393.     ELSE IF (Id = 'SPEE') AND NOT OktProcSPEE(St, Size) THEN EXIT
  394.     ELSE IF (Id = 'SLEN') AND NOT OktProcSLEN(St, Size) THEN EXIT
  395.     ELSE IF (Id = 'PLEN') AND NOT OktProcPLEN(St, Size) THEN EXIT
  396.     ELSE IF (Id = 'PATT') AND NOT OktProcPATT(St, Size) THEN EXIT
  397.     ELSE IF (Id = 'PBOD') AND NOT OktProcPBOD(St, Size) THEN EXIT
  398.     ELSE IF (Id = 'SBOD') AND NOT OktProcSBOD(St, Size) THEN EXIT;
  399.  
  400.     DoBlock := TRUE;
  401.   END;
  402.  
  403.  
  404.  
  405.  
  406. CONSTRUCTOR TOktFile.Init(VAR MySong: TSong);
  407.   BEGIN
  408.     TIffFile.Init;
  409.  
  410.     OktPBODCount   := 1;
  411.     OktSBODCount   := 1;
  412.     OktTrackCount  := 1;
  413.     OktMaxChannels := 0;
  414.  
  415.     MySong.SetName(MySong.FileName);
  416.     MySong.InitialTempo := 6;
  417.     MySong.InitialBPM   := 125;
  418.     MySong.Volume       := 255;
  419.     MySong.NumChannels  := 8;
  420.  
  421.     Song := @MySong;
  422.   END;
  423.  
  424.  
  425.  
  426.  
  427. DESTRUCTOR TOktFile.Done;
  428.   BEGIN
  429.     Song^.NumChannels := OktMaxChannels;
  430.     TIffFile.Done;
  431.   END;
  432.  
  433.  
  434.  
  435.  
  436. PROCEDURE LoadOktFileFormat (VAR Song: TSong; VAR St: TStream; VAR Header: TSongHeader);
  437.   VAR
  438.     f : TOktFile;
  439.     ModOkt : TModOktIdString ABSOLUTE Header;
  440.   BEGIN
  441.     Song.FileFormat := mffOktalizer;
  442.  
  443.     IF ModOkt <> ModOktIdString THEN
  444.       BEGIN
  445.         Song.Status := msNotLoaded;
  446.         EXIT;
  447.       END;
  448.  
  449.     Song.Status := msFileDamaged;
  450.  
  451.     St.Seek(St.GetPos + SizeOf(TModOktIdString));
  452.  
  453.     f.Init(Song);
  454.     f.Parse(St);
  455.     f.Done;
  456.  
  457.     IF Song.Status = msFileDamaged THEN
  458.       Song.Status := msOk;
  459.   END;
  460.  
  461.  
  462.  
  463.  
  464. END.
  465.